Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue31/cdevents/CDEVENTS.ZIP/CDEvents.pas

Pascal/Delphi Source File | 1998-01-21 | 8.8 KB | 204 lines

{***************************************************************************}
{ [TCDEVENTS]                                                               }
{   Special Units = DBTMsg                                                  }
{   Version = 1.0                                                           }
{ [SOURCE]                                                                  }
{   Copyright ⌐ 1998 by Tom Deprez                                          }
{   (Just to prevent to get multiple components, which all have great       }
{    things but would be a GREAT component with a lot of GREAT thing        }
{    That way everybody can benefit of such a GREAT component)              }
{ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ }
{ [COMPONENT]                                                               }
{ [properties]                                                              }
{ [events]                                                                  }
{   AfterArrival : Fires when new CD is inserted by user                    }
{   AfterRemove  : Fires when CD is removed by user                         }
{                                                                           }
{ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ }
{ [AUTHOR]                                                                  }
{   Author name   = ZifNab (Tom Deprez)                                     }
{   Author e-mail = [e-mail]                            }
{ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ }
{ [HISTORY]                                                                 }
{   18/01/1998 : first release                                              }
{                                                                           }
{***************************************************************************}

{***************************************************************************}
{  [COMMENTS]                                                               }
{   I very often visit the Delphi page of the www.Experts-Exchange.com site }
{   It's a place where you can ask or answer questions. One day somebody    }
{   needed to know when a CD is inserted in or ejected out of the CD-Rom    }
{   drive. I found it an interesting question, especially because I could   }
{   not find some 'delphi' source for this problem.                         }
{   I started to search for a solution.                                     }
{   Well, that was the beginning of this component. Where it ends?          }
{   That I don't know, it really depends on the reaction of you! If I get   }
{   some reaction, I'll futher improve it, otherwise it sticks with this.   }
{   Too bad, because I think it can become a great tool.                    }
{                                                                           }
{  [IMPORTANT]                                                              }
{    Made some improvements? : please let me know of, so I can update it    }
{    Need some improvements? : please, just ask and I'll try to make it     }
{    Have you got some ideas? : please, send them to me                     }
{    You use this component? : please, send me an e-mail, why you use this  }
{                              component. An E-mail isn't asked too much.   }
{                              Isn't it? At least let me know of the fact   }
{                              you're using it. It makes me very HAPPY!     }
{  [THANKS]                                                                 }
{    Matvey who brought the first idea to this component                    }
{    Perhaps YOU?                                                           }
{                                                                           }
{ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ }
{  [COPYRIGHT]                                                              }
{    This file is distributed as freeware and without warranties of any     }
{    kind. You can use it in your own applications at your own risk.        }
{                                                                           }
{  [NOTE]                                                                   }
{    It's freeware, but don't hesitate to send me some money if you've      }
{    become rich with the help of this component ;-)                        }
{    I's freeware, but don't hesitate to send me the program or the         }
{    component, where you use this component in. I would be ever gratefull  }
{    to you, thanks.                                                        }
{***************************************************************************}

unit CDEvents;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBTMsg, DsgnIntf;

const cVersion = '1.0';

type
 TDeviceChangeEvent = procedure (Sender : TObject; FirstDriveLetter : char)
                         of object;

 TAboutZifNabProperty = class(TPropertyEditor)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
  end;

 TCDEvents = class(TComponent)
  private
    { Private declarations }
     FAbout : TAboutZifNabProperty;
     FWindowHandle: HWND;
     fAfterArrival: TDeviceChangeEvent;
     fAfterRemove: TDeviceChangeEvent;
   procedure WndProc(var Msg: TMessage);
  protected
    { Protected declarations }
     function GetFirstDriveLetter(unitmask:longint):char;
     procedure WMDeviceChange(var Msg : TWMDeviceChange); dynamic;
  public
    { Public declarations }
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
  published
    { Published declarations }
    property About : TAboutZifNabProperty read FAbout write FAbout;
    property AfterArrival : TDeviceChangeEvent read fAfterArrival write fAfterArrival;
    property AfterRemove: TDeviceChangeEvent read fAfterRemove write fAfterRemove;
  end;

procedure Register;

implementation

{*********************** tAboutZifNabproperty component ***********************}

procedure TAboutZifNabProperty.Edit;
begin
  Application.MessageBox ('        tCDEvents v'+cVersion
                         +#13#10'This component is freeware.'
                         +#13#10'     ⌐ 1998 ZifNab         '
                         +#13#10''
                         +#13#10'mailto:[e-mail]',
                         'About',
                         MB_OK+ MB_ICONINFORMATION);
end;

function TAboutZifNabProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paDialog, paReadOnly];
end;

function TAboutZifNabProperty.GetValue: string;
begin
  Result := '(about)';
end;

{**************************** tCDEvents component *****************************}

constructor TCDEvents.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWindowHandle := AllocateHWnd(WndProc);
end;

destructor TCDEvents.Destroy;
begin
  DeallocateHWnd(FWindowHandle);
  inherited Destroy;
end;

procedure TCDEvents.WndProc(var Msg: TMessage);
begin
     if (Msg.Msg = WM_DEVICECHANGE) then
      try
        WMDeviceChange(TWMDeviceChange(Msg));
      except
        Application.HandleException(Self);
      end
    else
      Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;

function TCDEvents.GetFirstDriveLetter(unitmask : longint):char;
var DriveLetter : shortint;
begin
 DriveLetter := Ord('A');
 while (unitmask and 1)=0  do begin
  unitmask := unitmask shr 1;
  inc(DriveLetter);
 end;
 Result := Char(DriveLetter);
end;

procedure TCDEvents.WMDeviceChange(var Msg : TWMDeviceChange);
var lpdb : PDEV_BROADCAST_HDR;
    lpdbv : PDEV_BROADCAST_VOLUME;
begin
 (* received a wm_devicechange message *)
  lpdb := PDEV_BROADCAST_HDR(Msg.dwData);
   if lpdb^.dbch_devicetype = DBT_DEVTYP_VOLUME then begin
    (* message comes from a logical volume *)
    lpdbv := PDEV_BROADCAST_VOLUME(Msg.dwData);
    if (lpdbv^.dbcv_flags and DBTF_MEDIA) = 1 then begin
     (* Event's media flag is set *)
      case Msg.Event of
       DBT_DEVICEARRIVAL : if Assigned(fAfterArrival) then
                   fAfterArrival(Self,
                                 GetFirstDriveLetter(lpdbv^.dbcv_unitmask));
       DBT_DEVICEREMOVECOMPLETE : if Assigned(fAfterRemove) then
                   fAfterRemove(Self,
                                GetFirstDriveLetter(lpdbv^.dbcv_unitmask));
      end;
    end;
   end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TCDEvents]);
  RegisterPropertyEditor(TypeInfo(TAboutZifNabProperty), TCDEvents,
                         'ABOUT', TAboutZifNabProperty);
end;

end.